home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 1: Comms & Networking / Almathera Ten on Ten - Disc 1: Comms & Networking.iso / amiga-useful / perl / t / op / pat.t < prev    next >
Text File  |  1995-05-04  |  5KB  |  185 lines
  1. #!./perl
  2.  
  3. # $RCSfile: pat.t,v $$Revision: 4.0.1.2 $$Date: 91/06/10 01:29:34 $
  4.  
  5. print "1..51\n";
  6.  
  7. $x = "abc\ndef\n";
  8.  
  9. if ($x =~ /^abc/) {print "ok 1\n";} else {print "not ok 1\n";}
  10. if ($x !~ /^def/) {print "ok 2\n";} else {print "not ok 2\n";}
  11.  
  12. $* = 1;
  13. if ($x =~ /^def/) {print "ok 3\n";} else {print "not ok 3\n";}
  14. $* = 0;
  15.  
  16. $_ = '123';
  17. if (/^([0-9][0-9]*)/) {print "ok 4\n";} else {print "not ok 4\n";}
  18.  
  19. if ($x =~ /^xxx/) {print "not ok 5\n";} else {print "ok 5\n";}
  20. if ($x !~ /^abc/) {print "not ok 6\n";} else {print "ok 6\n";}
  21.  
  22. if ($x =~ /def/) {print "ok 7\n";} else {print "not ok 7\n";}
  23. if ($x !~ /def/) {print "not ok 8\n";} else {print "ok 8\n";}
  24.  
  25. if ($x !~ /.def/) {print "ok 9\n";} else {print "not ok 9\n";}
  26. if ($x =~ /.def/) {print "not ok 10\n";} else {print "ok 10\n";}
  27.  
  28. if ($x =~ /\ndef/) {print "ok 11\n";} else {print "not ok 11\n";}
  29. if ($x !~ /\ndef/) {print "not ok 12\n";} else {print "ok 12\n";}
  30.  
  31. $_ = 'aaabbbccc';
  32. if (/(a*b*)(c*)/ && $1 eq 'aaabbb' && $2 eq 'ccc') {
  33.     print "ok 13\n";
  34. } else {
  35.     print "not ok 13\n";
  36. }
  37. if (/(a+b+c+)/ && $1 eq 'aaabbbccc') {
  38.     print "ok 14\n";
  39. } else {
  40.     print "not ok 14\n";
  41. }
  42.  
  43. if (/a+b?c+/) {print "not ok 15\n";} else {print "ok 15\n";}
  44.  
  45. $_ = 'aaabccc';
  46. if (/a+b?c+/) {print "ok 16\n";} else {print "not ok 16\n";}
  47. if (/a*b+c*/) {print "ok 17\n";} else {print "not ok 17\n";}
  48.  
  49. $_ = 'aaaccc';
  50. if (/a*b?c*/) {print "ok 18\n";} else {print "not ok 18\n";}
  51. if (/a*b+c*/) {print "not ok 19\n";} else {print "ok 19\n";}
  52.  
  53. $_ = 'abcdef';
  54. if (/bcd|xyz/) {print "ok 20\n";} else {print "not ok 20\n";}
  55. if (/xyz|bcd/) {print "ok 21\n";} else {print "not ok 21\n";}
  56.  
  57. if (m|bc/*d|) {print "ok 22\n";} else {print "not ok 22\n";}
  58.  
  59. if (/^$_$/) {print "ok 23\n";} else {print "not ok 23\n";}
  60.  
  61. $* = 1;        # test 3 only tested the optimized version--this one is for real
  62. if ("ab\ncd\n" =~ /^cd/) {print "ok 24\n";} else {print "not ok 24\n";}
  63. $* = 0;
  64.  
  65. $XXX{123} = 123;
  66. $XXX{234} = 234;
  67. $XXX{345} = 345;
  68.  
  69. @XXX = ('ok 25','not ok 25', 'ok 26','not ok 26','not ok 27');
  70. while ($_ = shift(XXX)) {
  71.     ?(.*)? && (print $1,"\n");
  72.     /not/ && reset;
  73.     /not ok 26/ && reset 'X';
  74. }
  75.  
  76. while (($key,$val) = each(XXX)) {
  77.     print "not ok 27\n";
  78.     exit;
  79. }
  80.  
  81. print "ok 27\n";
  82.  
  83. 'cde' =~ /[^ab]*/;
  84. 'xyz' =~ //;
  85. if ($& eq 'xyz') {print "ok 28\n";} else {print "not ok 28\n";}
  86.  
  87. $foo = '[^ab]*';
  88. 'cde' =~ /$foo/;
  89. 'xyz' =~ //;
  90. if ($& eq 'xyz') {print "ok 29\n";} else {print "not ok 29\n";}
  91.  
  92. $foo = '[^ab]*';
  93. 'cde' =~ /$foo/;
  94. 'xyz' =~ /$null/;
  95. if ($& eq 'xyz') {print "ok 30\n";} else {print "not ok 30\n";}
  96.  
  97. $_ = 'abcdefghi';
  98. /def/;        # optimized up to cmd
  99. if ("$`:$&:$'" eq 'abc:def:ghi') {print "ok 31\n";} else {print "not ok 31\n";}
  100.  
  101. /cde/ + 0;    # optimized only to spat
  102. if ("$`:$&:$'" eq 'ab:cde:fghi') {print "ok 32\n";} else {print "not ok 32\n";}
  103.  
  104. /[d][e][f]/;    # not optimized
  105. if ("$`:$&:$'" eq 'abc:def:ghi') {print "ok 33\n";} else {print "not ok 33\n";}
  106.  
  107. $_ = 'now is the {time for all} good men to come to.';
  108. / {([^}]*)}/;
  109. if ($1 eq 'time for all') {print "ok 34\n";} else {print "not ok 34 $1\n";}
  110.  
  111. $_ = 'xxx {3,4}  yyy   zzz';
  112. print /( {3,4})/ ? "ok 35\n" : "not ok 35\n";
  113. print $1 eq '   ' ? "ok 36\n" : "not ok 36\n";
  114. print /( {4,})/ ? "not ok 37\n" : "ok 37\n";
  115. print /( {2,3}.)/ ? "ok 38\n" : "not ok 38\n";
  116. print $1 eq '  y' ? "ok 39\n" : "not ok 39\n";
  117. print /(y{2,3}.)/ ? "ok 40\n" : "not ok 40\n";
  118. print $1 eq 'yyy ' ? "ok 41\n" : "not ok 41\n";
  119. print /x {3,4}/ ? "not ok 42\n" : "ok 42\n";
  120. print /^xxx {3,4}/ ? "not ok 43\n" : "ok 43\n";
  121.  
  122. $_ = "now is the time for all good men to come to.";
  123. @words = /(\w+)/g;
  124. print join(':',@words) eq "now:is:the:time:for:all:good:men:to:come:to"
  125.     ? "ok 44\n"
  126.     : "not ok 44\n";
  127.  
  128. @words = ();
  129. while (/\w+/g) {
  130.     push(@words, $&);
  131. }
  132. print join(':',@words) eq "now:is:the:time:for:all:good:men:to:come:to"
  133.     ? "ok 45\n"
  134.     : "not ok 45\n";
  135.  
  136. @words = ();
  137. while (/to/g) {
  138.     push(@words, $&);
  139. }
  140. print join(':',@words) eq "to:to"
  141.     ? "ok 46\n"
  142.     : "not ok 46 @words\n";
  143.  
  144. @words = /to/g;
  145. print join(':',@words) eq "to:to"
  146.     ? "ok 47\n"
  147.     : "not ok 47 @words\n";
  148.  
  149. $_ = "abcdefghi";
  150.  
  151. $pat1 = 'def';
  152. $pat2 = '^def';
  153. $pat3 = '.def.';
  154. $pat4 = 'abc';
  155. $pat5 = '^abc';
  156. $pat6 = 'abc$';
  157. $pat7 = 'ghi';
  158. $pat8 = '\w*ghi';
  159. $pat9 = 'ghi$';
  160.  
  161. $t1=$t2=$t3=$t4=$t5=$t6=$t7=$t8=$t9=0;
  162.  
  163. for $iter (1..5) {
  164.     $t1++ if /$pat1/o;
  165.     $t2++ if /$pat2/o;
  166.     $t3++ if /$pat3/o;
  167.     $t4++ if /$pat4/o;
  168.     $t5++ if /$pat5/o;
  169.     $t6++ if /$pat6/o;
  170.     $t7++ if /$pat7/o;
  171.     $t8++ if /$pat8/o;
  172.     $t9++ if /$pat9/o;
  173. }
  174.  
  175. $x = "$t1$t2$t3$t4$t5$t6$t7$t8$t9";
  176. print $x eq '505550555' ? "ok 48\n" : "not ok 48 $x\n";
  177.  
  178. $xyz = 'xyz';
  179. print "abc" =~ /^abc$|$xyz/ ? "ok 49\n" : "not ok 49\n";
  180.  
  181. # perl 4.009 says "unmatched ()"
  182. eval '"abc" =~ /a(bc$)|$xyz/; $result = "$&:$1"';
  183. print $@ eq "" ? "ok 50\n" : "not ok 50\n";
  184. print $result eq "abc:bc" ? "ok 51\n" : "not ok 51\n";
  185.